00100	C*** 33 PARAMS SEEMS TO BE LIMIT IN THIS VERSION. (30 IN 'SCORE') *****
00200		SUBROUTINE TRANS(JJJ)
00300	CIN   DIMENSION IINS(108)
00400		DIMENSION NN(80)
00500	C  W(35) FOR PARAMETERS
00600	CIN   COMMON /TR/I(80),RX(100),JX(100),LX(12),INST(27,4),K
00700	C  THE 'ROUT' COMMON BLOCK IS 1ST OUTPUT BLOCK IN 'PASS3'.
00800	      COMMON /ROUT/I(200) ,RX(80),JX(80)  /TR/LX(12),K
00900	     1,INSNUM(27),P(30),NPAR(27),JSEM,IPRNT,IPP
01000	     1,SRATE,RNCHN,RMAG,INUM,INS,MM,M,N,JJ,X,Y,IK
01100	     1,ENDX,J  /KNAM/IPLAY,JFLNM  /IFIRST/IFIRST,IDT
01200		1 /INST/INST(27)
01300		1 /WDZ/WDZ(14),JWD(12)
01400	      COMMON /SBFILN/SBFILN /AR/IOP /IGEN/IGEN /JP/JPRNT
01500	      COMMON LL  /P/W(1)  /CONV/ICONV /FQDR/FQDR(28,27),INSN
01600	      INTEGER FQDR
01700	C****************CHECK NEAR HERE FOR NEEDED CHANGES **************
01800	CXX   DOUBLE PRECISION IDBL,JANP,JBLA,JFLNM,JDBG,
01900	CXX	1 INST,INAM,JSEMI,ICOLON
02000	      EQUIVALENCE (LESS,LX(9)),(IX,IXJ,JX),(RX2,RX(3)),
02100	     1(P2,P(2)),(RX3,RX(5)),(I3,I(3)),(ISEMI,LX(2))
02200	     1,(IBLA,LX(1)),(IAST,LX(3)),(IINS,INST)
02300	     1,(IAROW,LX(7)),(W1,W),(W3,W(3)),(W2,W(2))
02400	CXX   DATA LX/' ',';', '*','/','-','+'
02500	CXX	1,'←','=', '<', ',', '(', ')'/,  IFIRST/-1/,IOPEN/-1/
02600	C****************CHECK NEAR HERE FOR NEEDED CHANGES **************.
02700	C  THE BIG NUMBER BELOW IS A LEFT ARROW.
02800	
02900	      DATA LX/' ',';', '*','/','-','+'
03000	     1,"575004020100,'=','<' ,',' ,'(', ')'/,
03100	     1  IDOT/'.'/, IDEV/1/,JPRNT/1/,JFLNM/'TRNS'/
03200		1,JBLA/'    '/,JDBG/'#   '/,JPERC/'%   '/,JSEMI/';   '/
03300	C*** THIS VERSION STARTS OUT WITH DEFAULT OUTPUT TO FILE: TRNS.DAT
03400	      DATA RMAG/.0512/,INUM/0/,SRATE/12800./,RNCHN/1./,JQUOT/'"    '/
03500		1,JEXP/'!   '/,JANP/'&   '/,ICONV/-1/,JCOLON/':   '/
03600	C ICONV=-1 MEANS WRITE A SOUND FILE. (=0 = WRITE A FILE FOR 'SMPLS' PROG.)
03700	
03800		GO TO (555,500) JJJ
03900	555      IF(IFIRST)404,  5,5  
04000	404      IGEN=-1
04100		KA=1
04200	C KA IS POINTER TO INPUT ARRAY
04300		IF(INUM.NE.0)GO TO 30
04400		DO 411 K=1,27 
04500	411	INST(K)=0
04600	CIN	DO 411 K=1,108
04700	CIN411	IINS(K)=0
04800	C ZERO OUT INSTR. NAME ARRAY.
04900	30    IPLAY=0
05000	      ENDX=0
05100		KK=0
05200	      JSEM=0
05300	      INS=-1
05400	402      IDEV=1
05500	412      TYPE 1
05600	1	 FORMAT(' INPUT? '$)
05700	100      FORMAT(' >'$)
05800	2      FORMAT(A4)
05900	      ACCEPT 2,IDBL
06000	C IDBL WILL HAVE TO BE DOUBLE PREC. ON PDP11 ************
06100	      IF(IDBL.NE.JBLA)GO TO 400
06200	      IDEV=5
06300	      GO TO 5
06400	400      IF(IDBL.NE.JANP)GO TO 602    
06500		JPRNT=-JPRNT
06600		GO TO 412
06700	C!*** & IS PRNT-NOPRNT FLIPFLOP
06800	602      IF(IDBL.NE.JQUOT)GO TO 408
06900	C!*** " FOR INSTRUMENT LIST.
07000	      DO 606 K=1,INUM
07200		JK=INSNUM(K)
07300		MM=NPAR(JK)-2
07400	606      TYPE 607,INST(K),JK,MM
07500	CIN606      TYPE 607,(INST(K,L),L=1,4),JK,NPAR(JK)
07600	CC606      TYPE 607,(INST(K,L),L=1,4),INSNUM(K),JK
07700	      GO TO 402
07800	607      FORMAT(1X,A4,'  NUM=',I2,'  PARAMS=',I2)      
07900	CIN607      FORMAT(1X,4A1,'  NUM=',I2,'  PARAMS=',I2)      
08000	C!*** PRINTS INST INFO.
08100	408	IF(IDBL.NE.JEXP)GO TO 603
08200	C TRIGGERS ICONV FLIPFLOP
08300		IF(ICONV)GO TO 2408
08400		ICONV=-1
08500		TYPE 3408
08600		GO TO 412
08700	2408	ICONV=0
08800		TYPE 4408
08900		GO TO 412
09000	3408	FORMAT(' OUTPUT=TEST.SND'/)
09100	4408	FORMAT(' OUTPUT=TEST.DAT'/)
09200	603	IF(IDBL.EQ.JPERC)CALL PLAY
09300	C TYPE % TO RE-PLAY SOUND
09400	CXX	IF(IDBL.NE.JDBG)GO TO 410
09500	CXX4448	TYPE 4023
09600	CXX4446	TYPE 4445
09700	CXX	ACCEPT 51,KI
09800	CXX	IF(KI.EQ.0)GO TO 4022
09900	CXX	IF(KI.GT.0)GO TO 4447
10000	C******** THIS STUFF FOR DIAGNOSIS
10100	CXX	IF(KI.EQ.-1)TYPE 2325,IGEN
10200	CXX	IF(KI.EQ.-2)TYPE 2325,IPRNT
10300	CXX	IF(KI.EQ.-3)TYPE 2325,IPLAY
10400	CXX	IF(KI.EQ.-4)TYPE 2325,JSEM
10500	CXX	IF(KI.EQ.-5)TYPE 2325,J
10600	CXX	IF(KI.EQ.-6)TYPE 2325,MM
10700	CXX	GO TO 4446
10800	CXX4022	IF(IDEV.EQ.1)GO TO 402
10900	C GO BACK TO 'INPUT' OR '>'
11000	CXX	GO TO 502
11100	C THIS WILL TYPE OUT ELEMENTS OF LX ARRAY.
11200	CXX4447	TYPE 2326,LX(KI)
11300	CXX	TYPE 2325,LX(KI)
11400	CXX	GO TO 4446
11500	CXX4445	FORMAT(' TYPE LX NUMB.   '$)
11600	CXX4023	FORMAT(' IGEN, IPRNT, IPLAY, JSEM, J, MM'/)
11700	CXX2324	FORMAT(1X12F/)
11800	CXX2325	FORMAT(1X5I/)
11900	2326	FORMAT(1X80A1)
12000	410	IF(IDBL.EQ.JCOLON)CALL EXIT
12100	C TYPE ':' TO EXIT AND CLOSE ALL FILES.
12200		CALL IFILE(1,IDBL)
12300	C NOW IT BELIEVES YOU'VE TYPED A FILE NAME.
12400	CX	CALL OPEN(1,IDBL,0,'RDO')
12500	4      FORMAT(80A1)
12600	C****************
12700	CX	TYPE 2325,JSEM
12800	CX	TYPE 2325,J
12900	CX	TYPE 2325,MM
13000	
13100	5     IF(KA.NE.1)GO TO 521
13200	502      IF(IDEV.NE.5)GO TO 601
13300	C*******************************
13400	      IF(IGEN.NE.2)IGEN=-1
13500	503      TYPE 100
13600	C*******************************
13700	601	KA=1
13800		READ(IDEV,4,END=404)NN
13900	121	DO 421 LEND=80,1,-1
14000	C FIND LAST CHAR. IN LINE
14100	421	IF(NN(LEND).NE.IBLA)GO TO 621
14200	C NOW WE'VE FOUND A BLANK LINE
14300		IF(IDEV.EQ.1)GO TO 601
14400		GO TO 402
14500	621	IF(IDEV.EQ.5)GO TO 521 
14600		IF(JPRNT.LT.0)TYPE 2326,(NN(IJI),IJI=1,LEND)
14700	521	IF(KK.EQ.0)JA=0
14800	C KK IS FLAG FOR CONTINUATION LINES.
14900		DO 21 LSEM=KA,LEND
15000		LS=NN(LSEM)
15100		IF(LS.NE.LESS)GO TO 21
15200		KK=0
15300		GO TO 601
15400	21	IF(LS.EQ.ISEMI)GO TO 821
15500	C SET FLAG TO LOOP BACK TO READ ANOTHER LINE
15600		KK=-1
15700		GO TO 721
15800	
15900	821	KK=0
16000	C SET KK TO 0 EVERY TIME WE HIT A SEMICOLON
16100	221	IF(LSEM.EQ.1)GO TO 721
16200		KB=LSEM-1
16300		IF(NN(KB).NE.IBLA)GO TO 721
16400	C DELETE BLANKS BEFORE A SEMICOLON
16500		NN(KB)=ISEMI
16600		NN(LSEM)=IBLA
16700		IF(LEND.EQ.LSEM)LEND=LEND-1
16800		LSEM=LSEM-1
16900		GO TO 221
17000	721	IF(JA.EQ.0)GO TO 921
17100		JA=JA+1
17200		I(JA)=IBLA
17300	C INSERT A BLANK IF A CONTINUATION LINE.
17400	921   	KC=IBLA
17500	C LEADING BLANKS AND MULTIPLE BLANKS ARE DELETED.
17600		DO 321 KB=KA,LSEM
17700	C LSEM IS CHAR COUNT IN I ARRAY NOW (LOCATES THE SEMI COLON)
17800		K=NN(KB)
17900		IF(K.NE.IBLA)GO TO 1021
18000		IF(KC.EQ.IBLA)GO TO 321
18100	C DELETE STRINGS OF BLANKS
18200	1021	JA=JA+1
18300		I(JA)=K
18400		KC=K
18500	321	CONTINUE
18600	C CURRENTLY CAN STORE 200 CHARS. IN I ARRAY. (ENOUGH FOR 30 PARAMS?)
18700		KA=LSEM+1
18800		IF(KA.GT.LEND)KA=1
18900		IF(KK.NE.0)GO TO 502
19000	C GO READ MORE IF NO SEMICOLON WAS FOUND.
19100		IF(I(1).EQ.ISEMI)GO TO 5
19200	C CATCHES DUPLICATE SEMICOLON
19300	1408      DO 407 K=1,80 
19400	407      JX(K)=IBLA
19500	406      MM=0
19550	C INIT VARIOUS THINGS
19600		DO 4061 J=2,80,2
19700	4061	RX(J)=0
19800	        J=-1      
19900	      IPRNT=0
20000	119      JI=0
20100	9      M=0
20200		N=JI+1
20300	6      JI=JI+1
20400		   KCHAR=I(JI)
20500	      DO 7 L=1,12
20600	7      IF(KCHAR.EQ.LX(L))GO TO 8
20650	C JUMP OUT IF PUNCT., SPACE, SEMI., ETC.
20700	      M=M+1
20800	      GO TO 6            
20900	C!**** NO STRING CAN EXCEED 10 CHARS.
21000	8       IF(M.EQ.0)GO TO 140
21100	      IF(M.GT.10)M=10
21200	      MM=MM+1
21300	      IF(MM.LE.40)GO TO 88
21400	      TYPE 888,(I(JJ),JJ=N,N+9)
21500	      STOP
21600	888      FORMAT(' LINE TOO LONG -- ',10A1)
21700	88      JJ=I(N)
21800		IF(JJ.GT.'9')GO TO 16  
21900		IF(JJ.NE.IDOT.AND.JJ.LT.'0')GO TO 16
22000	CXX	IF(JJ.GT.8249)GO TO 16  
22100	CXX	IF(JJ.NE.IDOT.AND.JJ.LT.8240)GO TO 16
22200	C**** 8240='0'  8249='9'
22300	C!***** JUMP IF 1ST CHAR. IS A LETTER.
22400		Y=0
22500	      DOT=10.
22600	      DO 18 JK=N,N+M-1
22700	      KB=I(JK)
22800	      IF(KB.NE.IDOT)GO TO 17
22900	      DOT=.1
23000	      GO TO 18
23200	17    X=NASCI(KB)                 
23300	C!**** CHANGE ASCII INTO NUMBER
23400	      IF(DOT.LT.1)GO TO 19
23500	      Y=Y*DOT+X
23600	      GO TO 18
23700	19      Y=Y+X*DOT
23800	      DOT=DOT/10.
23900	18      CONTINUE
23950		IF(IGEN.EQ.2)Y=Y*100+1000.
23975	C ABOVE PUTS CONSTANTS IN INS DEFINITIONS. PLUS ONLY. LIMIT??
24000	      RX(MM*2-1)=Y
24100	      RX(MM*2)=-9999.0
24200	      GO TO 140
24300	
24400	16	JK=MM*2-1
24500	CX	JX(JK)=0
24600	CX	RX(JK)=0
24700	CX	JX(JK+1)=0
24800	CX	RX(JK+1)=0
24900	        CALL MPACK(M,I(N),JX(JK),N)
25000	C N=CURRENT POINTER TO I ARRAY - USED LATER TO LOCATE INST. NAMES.
25100		IJ=JX(JK)
25200		IF(IJ.GE.0)GO TO 144
25300	C IF IJ < 0, THEN IT'S A LETTER
25400		JX(MM*2)=M
25500	C SAVE THE WD CNT OF POTENTIAL INST. NAME.
25600		GO TO 143
25700	144	IF(IJ.NE.408)GO TO 140
25750	C "WORD" TYPES OUT RESERVED WORD LIST
25800		TYPE 244,WDZ,JWD
25900		GO TO 503
26000	244	FORMAT(15(1XA4))
26100	140      IF(IJ.EQ.400)GO TO 5
26200	C  400='PLAY;' THIS CAN BE THROWN AWAY NOW.
26700	143	IF(KCHAR.EQ.IBLA)GO TO 10
26800	      IF(L.EQ.8)KCHAR=IAROW      
26900	C!::: CHANGE = INTO ←
27200	141   MM=MM+1
27300		KI=MM*2-1
27400		JX(KI)=KCHAR
27500	10      IF(JI.EQ.JA)GO TO 15
27600	C  JA POINTS TO LAST CHAR. TO LOOK AT FOR NOW.
27700	1010	IF(I(JI+1).NE.IBLA)GO TO 11
27800	      JI=JI+1
27900	      GO TO 1010
28000	11	IF(JI.LT.JA)GO TO 9
28100	C NOW WE HAVE ALL ITEMS IN IX ARRAY
28200		IF(MM.GT.1)GO TO 15
28300	C CATCH 'WORD  ;' AT END OF LINE
28400		IF(M.EQ.0)GO TO 5
28500	15      MM=MM*2
29000	142      J=-1      
29100	      IF(INS.LT.0)GO TO 305
29200	      IF(INS.EQ.2)GO TO 305
29300	      MM=0
29400	      INS=-1    
29500	C!***** NOW INITIALIZATION COMPLETE
29600	      GO TO 5
29700	50      LL=LL-1
29800		IF(IGEN)308,309,309
29900	CC50      IF(IGEN)308,309,309
30000	CC309      LL=LL-1
30100	CC309   IF(JSEM.LE.0.AND.IGEN.EQ.1)IGEN=-1   
30200	309   IF(IJ.EQ.12)IGEN=-1   
30300	C!*** FOUND 'END'
30400	      GO TO 59
30500	308      W1=1
30600		IK=W2
30700	      IF(LL.GT.NPAR(IK))GO TO 56
30800	54      IF(LL.LT.3)LL=3
30900	      DO 55 K=LL,NPAR(IK)
31000	55      W(K)=P(K-2)    
31100	C!***** GET INFO ALREADY IN PARAMS
31200	56      DO 57 K=3,LL
31300	57      P(K-2)=W(K)      
31400	C!**** FILL UP P LIST AGAIN
31500	      X=W3            
31600	C!*** EXCHANGE W2 AND W3, ACTION TIME, INST #
31700	      W3=W2
31800	      W2=X
31900	58      LL=NPAR(IK)
32000	      DO 52 K=5,LL
32100		KI=FQDR(K-4,IK)
32200		IF(KI)53,52,2352
32300	2352      W(K)=RMAG/W(K)
32400	      GO TO 52
32500	53      W(K)=RMAG*W(K)
32600	52      CONTINUE
32700	      IF(ENDX.LT.W2+P2)ENDX=W2+P2
32800	59       IF(W1.NE.2.)GO TO 592
32900		IF(LL.EQ.2)GO TO 597
33000	C JUMP IF 'END' OF INS DEF.
33100		IF(LL.NE.3)GO TO 595
33200	C  JUMP IF NOT AN INST DEF.
33300		PSV=0
33400		SV=35
33500	C EXPLAIN USE OF STORAGE PARAMS!!
33600		INSN=W3
33700	C  INS DEF NUM.
33800		DO 586 K=1,28
33900	C CLEAR FREQ-DUR FLAGS FOR THIS INST.
34000	586	FQDR(K,INSN)=0
34100	CC	JINS=INUM
34200	C LIST OF INST NAMES MUST FOLLOW 'INS 0 N;'  !!!ALWAYS!!!
34300	CIN596	INUM=INUM+1
34400	CIN596	READ(IDEV,2)INST(INUM)
34500	596	READ(IDEV,2,END=587)INAM
34600		IF(INAM.EQ.JSEMI)GO TO 592
34700	C LIST OF INST NAMES TERMINATES WITH ';'.
34800		DO 588 K=1,INUM
34900		IF(INAM.NE.INST(K))GO TO 588
35000		INST(K)=INAM
35100		INSNUM(K)=INSN
35200		GO TO 589
35300	587	PAUSE 'MISSING SEMICOLON'
35400	588	CONTINUE
35500		INUM=INUM+1
35600		INST(INUM)=INAM
35700	CIN	READ(IDEV,4)(INST(INUM,K),K=1,4)
35800	CIN	IF(INST(INUM,1).EQ.ISEMI)GO TO 599
35900	C LIST OF INST NAMES TERMINATES WITH ';'.
36000		INSNUM(INUM)=INSN
36100	589	IF(JPRNT)TYPE 244,INAM
36200	CIN	IF(JPRNT)TYPE 2326,(INST(INUM,K),K=1,4)
36300		GO TO 596
36400	CIN599	INUM=INUM-1
36500	
36600	595	DO 593 K=3,LL
36700		X=W(K)
36800		IF(X.LT.0.OR.X.GT.100)GO TO 593
36900		IF(X.GT.PSV)PSV=X
37000	C CHECK FOR OVERLAPPING PARAM NUMS.
37100	593	CONTINUE
37200		 IF(W3.NE.102.AND.W3.NE.105.AND.W3.NE.111.AND.W3.NE.104
37300		1 .AND.W3.NE.115)GO TO 592
37400	C 115=NOS, 102=OSC, 105=ENV, 104=RAI (3 STOR. LOCS), 111=RAH (2 STOR. LOCS)
37500	C NEXT SETS UP STORAGE LOCATIONS FOR OSC, ENV, RAN, AND RAH.
37600		X=W3
37700	594	LL=LL+1
37800		W(LL)=SV
37900		SV=SV-1
38000	C DECREMENT THE HIGH PARAM NUM.
38100		IF(SV.LT.PSV)PAUSE 'PARAMETER OVERLAP'
38200	CIN	IF(SV.LT.PSV)CALL ERROR(5)
38300	C  IF STORAGE PARAM NUM. OVERLAPS WITH INSTS/'S PARAMS = ERROR
38400		IF(X.NE.111.AND.X.NE.104)GO TO 592
38500		IF(X.EQ.111)X=0
38600		IF(X.EQ.104)X=111
38700		GO TO 594
38800	
38900	597	NPAR(INSN)=PSV
39000	C SAVE THE HIGHEST PARAM NUM.
39100	
39200	592	IF(JPRNT.GE.0)GO TO 591
39300	      TYPE 51,LL,(W(K),K=1,LL)
39400	CXX   WRITE(22,51)LL,(W(K),K=1,LL)
39500	C ABOVE WRITES ONTO FILE 'D.DAT' *** TEMPORARY FOR DEBUGGING.
39600	591      IDT=2
39700	CZZ ????	IF(IOPEN.LT.0)CALL OFILE(21,JFLNM)
39800	C OPENS FILE, IF NOT ALREADY OPEN.
39900	CZZ	WRITE(21)LL,(W(K),K=1,LL)
40000		RETURN
40100	
40200	500      IFIRST=0
40300	      IF(IGEN.EQ.0)IGEN=-1
40400	      IF(W1.NE.6)GO TO 555
40500	      RETURN
40600	C  W1=6 = 'FINISH;'  [W ARRAY IS EQUIV. TO P ARRAY IN MUSIC5]
40700	
40800	306      IF(JPRNT.LT.0)TYPE 1307,(W(K),K=1,LL-1)
40900		      IF(JPRNT.GT.0)TYPE 307,(W(K),K=1,LL-1)
41000	      IPRNT=0                  
41100	C!** RESET NO-PRNT FLAG
41400	      INS=-1
41450		GO TO 5
41500	CC      IF(J.GE.MM-1)GO TO 5      
41600	C!** GO READ ANOTHER LINE
41700	305	CALL MSCAN
42100		IF(IJ.EQ.401)GO TO 500
42200	C 401=FINISH WAS FOUND.
42300		IF(IPRNT.LT.0)GO TO 306
42400		IF(JSEM.EQ.0)GO TO 5
42500		GO TO 50
42600	51      FORMAT(I3,35F10.3/)
42700	307      FORMAT('+',F8.2,$)
42800	1307      FORMAT(F10.3)
42900	      END
43000	
43100		FUNCTION NASCI(N)
43200		DATA IEX/536870912/,IZERO/'0'/
43300	C THIS BIG NUMBER MUST BE CHANGED ON PDP11***************
43400		NASCI=(N-IZERO)/IEX
43500	C CONVERTS SINGLE ASCII CHARACTER TO INTEGER.
43537	CXX	NASCI=N-8240
43575	C  THIS FORM FOR PDP11
43600		END
43700